c
c-----------------------------------------------------------------------------
c
c  NacaFoil.f -- generates a NACA foil section. The foil type is selected
c                using the NACA foil descriptor.
c
c  Written By: S.E.Norris          
c
c  norris@cfd.mech.unsw.edu.au
c
c  $RCSfile: nacafoil.f,v $
c  $Author: norris $
c  $Revision: 1.5 $
c  $Date: 1995/08/31 11:05:52 $
c
c  $Log: nacafoil.f,v $
c  Revision 1.5  1995/08/31  11:05:52  norris
c  *** empty log message ***
c
c  Revision 1.4  1995/08/31  03:35:01  norris
c  Changed to use the directory.h header file that holds the directory name.
c
c  Revision 1.3  1995/08/31  02:03:05  norris
c  Added the use of the lnblnk function to generate pathnames.
c
c  Revision 1.2  1995/08/30  11:48:41  norris
c  Updated file so that it has alot of the non-standard F77 stuff removed.
c
c-----------------------------------------------------------------------------
c
      SUBROUTINE NacaFoil( x,npl,npmx,naca,scle,inaca,t_n,nmn )
c
      IMPLICIT none
      INTEGER npl,npmx,inaca,nmn
      REAL x(3,npmx),scle
      CHARACTER naca*(*)
      LOGICAL t_n
c
c  Converts a string into a NACA section.
c
c     x(i,j)   Contains the x,y coordinates of the foil
c     npl      Number of points in foil description
c     inaca    
c     nmn      
c     naca*(*) String containing the NACA foil number
c     scle     Length to scale the foil by
c     t_n      Returns weather we could generate the foil
c
c
      t_n = .true.
c
      if (naca(3:3).eq.'-') then
	 if (naca(1:1).eq.'1') then
	    call Naca_1( x,npl,npmx,naca,inaca,scle,t_n )
	 else if (naca(1:1).eq.'6') then
	    call Naca_6( x,npl,npmx,naca,inaca,scle,t_n,nmn )
	 else
	    t_n = .false.
	 endif
      else if (naca(3:3).eq.'A') then
	 call Naca_6( x,npl,npmx,naca,inaca,scle,t_n,nmn )
      else if (naca(3:3).eq.'(') then
	 call Naca_6( x,npl,npmx,naca,inaca,scle,t_n,nmn )
      else if (naca(5:5).eq.' ' .or. naca(5:5).eq.'-') then
	 call Naca_4( x,npl,npmx,naca,inaca,scle,t_n )
      else if (naca(6:6).eq.' ' .or. naca(6:6).eq.'-') then
	 call Naca_5( x,npl,npmx,naca,inaca,scle,t_n )
      else
	 t_n = .false.
      endif
c
      return
      END
c
c-----------------------------------------------------------------------------
c
      SUBROUTINE Naca_4( x,npl,npmx,naca,inaca,scle,t_n )
c
      IMPLICIT none
      INTEGER npl,npmx,inaca
      REAL x(3,npmx),scle
      CHARACTER naca*(*)
      LOGICAL t_n
c
c  Checks for correct 4-digit name, and checks for modified section
c
      LOGICAL modified
      LOGICAL Digit
      EXTERNAL Digit
c
      if (.not. Digit( naca(1:4),4 )) then
	 t_n = .false.
      else if (naca(5:5).eq.'-') then
	 if (.not. Digit( naca(6:7),2 )) then
	    t_n = .false.
	 else
	    modified = .true.
	 endif
      else
	 modified = .false.
      endif
c
      if (t_n) then
	 call Naca4( x,npl,npmx,naca,inaca,scle,modified )
      endif
c
      return
      END
c
c-----------------------------------------------------------------------------
c
      SUBROUTINE Naca_5( x,npl,npmx,naca,inaca,scle,t_n )
c
      IMPLICIT none
      INTEGER npl,npmx,inaca
      REAL x(3,npmx),scle
      CHARACTER naca*(*)
      LOGICAL t_n
c
c  Checks for correct 5-digit name, and checks for modified section
c
      LOGICAL modified
      LOGICAL Digit
      EXTERNAL Digit
c
      if (.not. Digit( naca(1:5),5 )) then
	 t_n = .false.
      else if (naca(6:6).eq.'-') then
	 if (.not. Digit( naca(7:8),2 )) then
	    t_n = .false.
	 else
	    modified = .true.
	 endif
      else
	 modified = .false.
      endif
c
      if (t_n) then
	 call Naca5( x,npl,npmx,naca,inaca,scle,modified )
      endif
c
      return
      END
c
c-----------------------------------------------------------------------------
c
      SUBROUTINE Naca_1( x,npl,npmx,naca,inaca,scle,t_n )
c
      IMPLICIT none
      INTEGER npl,npmx,inaca
      REAL x(3,npmx),scle
      CHARACTER naca*(*)
      LOGICAL t_n
c
c  Checks for correct 1-series name
c
      LOGICAL Digit
      EXTERNAL Digit
c
      if (naca(2:2).ne.'6') then
	 t_n = .false.
      else if (.not. Digit( naca(4:6),3 )) then
	 t_n = .false.
      endif
c
      if (t_n) then
	 call Naca1( x,npl,npmx,naca,inaca,scle,t_n )
      endif
c
      return
      END
c
c-----------------------------------------------------------------------------
c
      SUBROUTINE Naca_6( x,npl,npmx,naca,inaca,scle,t_n,nmn )
c
      IMPLICIT none
      INTEGER npl,npmx,inaca,nmn
      REAL x(3,npmx),scle
      CHARACTER naca*(*)
      LOGICAL t_n
c
c  Checks for correct 6-series name
c
      INTEGER i
      CHARACTER type*3
      REAL a
      REAL Rst
      LOGICAL Digit
      EXTERNAL Digit,Rst
c
      a = 1.0
c
      if (naca(1:1).ne.'6') then
	 t_n = .false.
      else if (.not. Digit( naca(2:2),1 )) then
	 t_n = .false.
      else if (naca(3:3).eq.'-') then
	 if (.not. Digit( naca(4:6),3 )) then
	    t_n = .false.
	 else if (naca(7:8).eq.'a=') then
	    a = Rst( 3,naca(9:11),1.0 )
	 endif
	 type = '-  '
      else if (naca(3:3).eq.'A') then
	 if (.not. Digit( naca(4:6),3 )) then
	    t_n = .false.
	 else if (naca(7:8).eq.'a=') then
	    a = Rst( 3,naca(9:11),1.0 )
	 endif
	 type = 'A  '
c
      else if (naca(3:3).eq.'(') then
	 if (.not. Digit( naca(4:4),1 )) then
	    t_n = .false.
	 else if (.not.Digit( naca(5:5),1 )) then
	    if (naca(5:5).eq.')') then
	       i = 6
	       type(2:3) = '(1'
	    else
	       t_n = .false.
	    endif
	 else if (naca(6:6).eq.')') then
	    i = 7
	    type(2:3) = '(2'
	 else
	    t_n = .false.
	 endif
c
	 if (t_n) then
	    if (naca(i:i).eq.'-') then
	       if (.not. Digit( naca(i+1:i+3),3 )) then
		  t_n = .false.
	       else if (naca(i+4:i+5).eq.'a=') then
		  a = Rst( 3,naca(i+6:i+8),1.0 )
	       endif
	       type(1:1) = '-'
	    else if (naca(i:i).eq.'A') then
	       if (.not. Digit( naca(i+1:i+3),3 )) then
		  t_n = .false.
	       else if (naca(i+4:i+5).eq.'a=') then
		  a = Rst( 3,naca(i+6:i+8),1.0 )
	       endif
	       type(1:1) = 'A'
	    else
	       t_n = .false.
	    endif
	 endif
      else
	 t_n = .false.
      endif
c
      call Naca6o( naca,inaca,type,t_n,nmn )
      if (a.lt.0.0 .or. a.gt.1.0 )a = 1.0
      if (t_n) then
	 call Naca6( x,npl,npmx,naca,inaca,scle,a,type,t_n )
      endif
c
      return
      END
c
c-----------------------------------------------------------------------------
c
      SUBROUTINE Naca6o( naca,inaca,type,t_n,nmn )
c
      IMPLICIT none
      INTEGER inaca,nmn
      CHARACTER naca*15,type*3
      LOGICAL t_n
c
c  Checks that the NACA profile is valid. If it isnt, replaces it with
c  the closest available profile.
c
      INCLUDE 'directory.h'
      INTEGER ndata(3),ibase,im,i
c     INTEGER icl,itau
      CHARACTER string*15,filnme*6,fullpath*128
      LOGICAL fex
      CHARACTER Sti*2
      INTEGER Lnblnk
      EXTERNAL Sti,Lnblnk
c
c     Get the foil profile name.
c
      fex = .true.
      string = ' '
      call Naca6p( naca,inaca,ndata,filnme,type )
c     icl   = ndata(1)
c     itau  = ndata(2)
      ibase = ndata(3)
c
c     Catch cases where a 6X(Y) is declared as a 6X(0Y).
c
      if (type(2:3).eq.'(2' .and. ibase.lt.10) then
	 do i = 5,15
	    im = i-1
	    naca(im:im) = naca(i:i)
	 enddo
	 naca(15:15) = ' '
	 type(3:3) = '1'
      endif
c
c     Check 'A' series foils.
c
      if (type(1:1).eq.'A') then
c
c        Check that we havnt got a 61-XXX etc.
c
	 if (naca(2:2).lt.'3' .or. naca(2:2).gt.'5') then
	    t_n = .false.
	    return
	 endif
c
c        Check that profile is defined.
c
         fullpath = direct//filnme
	 inquire( file=fullpath,exist=fex )
	 if (.not. fex) then
c
c           Find appropriate base profile.
c
	    if (ibase.lt.6) then
	       ibase = 6
	    else if (ibase.gt.15) then
	       ibase = 15
	    else if (ibase.eq.11 .or. ibase.eq.13 .or. ibase.eq.9) then
	       ibase = ibase-1
	    else
	       ibase = ibase+1
	    endif
	 endif
c
c     Check '-' series foils.
c
      else
c
c        Check that we havnt got a 61-XXX etc.
c
	 if (naca(2:2).lt.'3' .or. naca(2:2).gt.'7') then
	    t_n = .false.
	    return
	 endif
         fullpath = direct//filnme
	 inquire( file=fullpath,exist=fex )
	 if (.not. fex) then
c
c           Find appropriate base profile.
c
	    if (naca(2:2).eq.'7') then
	       ibase = 15
	    else if (ibase.lt.6) then
	       ibase = 6
	    else if (ibase.gt.21) then
	       ibase = 21
	    else if (ibase.eq. 7 .or. ibase.eq.13
     &          .or. ibase.eq.16 .or. ibase.eq.19)then
	       ibase = ibase-1
	    else
	       ibase = ibase+1
	    endif
	 endif
      endif
c
c
      if (.not. fex) then
c
c        Construct new NACA foil name.
c
	 if (type(2:3).eq.'(1') then
	    naca(4:4) = Sti( ibase,'I1' )
	 else if (type(2:3).eq.'(2') then
	    naca(4:5) = Sti( ibase,'I2' )
	 else
	    if (ibase.lt.10) then
	       string(1:14) = naca(1:2)//'( )'//naca(3:11)
	       string(4:4)  = Sti( ibase,'I1' )
	       type(2:3) = '(1'
	       nmn = nmn+3
	    else
	       string(1:15) = naca(1:2)//'(  )'//naca(3:11)
	       string(4:5)  = Sti( ibase,'I2' )
	       type(2:3) = '(2'
	       nmn = nmn+4
	    endif
	    naca = string
	 endif
      endif
c
      return
      END
c
c-----------------------------------------------------------------------------
c
      SUBROUTINE Naca6p( naca,inaca,ndata,filnme,type )
c
      IMPLICIT none
      INTEGER inaca
      INTEGER ndata(3)
      CHARACTER naca*(*),filnme*6,type*3
c
c  This routine converts a NACA number into the parameters describing
c  a foil.
c
      INTEGER i
      INTEGER icld,itau,ibase
      INTEGER Ist
      EXTERNAL Ist
c
c
      if (type(2:2).ne.'(') then
	 filnme = naca(1:3)//'0'//naca(5:6)
	 ibase  = Ist( 2,naca(5:6),0 )
	 i = -3
      else
	 if (type(3:3).eq.'1') then
	    i = 0
	    filnme = naca(1:2)//type(1:1)//'00'//naca(4:4)
	 else if (type(3:3).eq.'2') then
	    i = 1
	    filnme = naca(1:2)//type(1:1)//'0'//naca(4:5)
	 endif
	 ibase  = Ist( 2,naca(4:4+i),0 )
      endif
c
      inaca= Ist( 2,naca(8+i:9+i),0 )
      icld = Ist( 1,naca(7+i:7+i),0 )
      itau = Ist( 2,naca(8+i:9+i),0 )
      ndata(1) = icld
      ndata(2) = itau
      ndata(3) = ibase
c
      return
      END
